#!/usr/bin/perl -wT
use strict;
use strict;
use Template;
use CGI qw/*table/;
use CGI::Cache;
use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
use CGI::PathInfo;
use CGI::Pretty;
use CGI::FormBuilder;
use CGI::FormBuilder::Messages;
use DBI;
use DBD::Pg qw(:pg_types);
use Data::Dumper;
use MassSpec::ViewSpectrum;
BEGIN {push @INC,".";$ENV{'PATH'}="/bin:/usr/bin:/usr/local/bin";}
use commoncode;

my $cgi = new CGI();

my $PATHINFO;
if (defined $ENV{'PATH_INFO'}) {
  if ($ENV{'PATH_INFO'}!~m/^([0-9a-zA-Z\/._+-]*)$/) {
    die("Bad characters in PATH_INFO: $ENV{'PATH_INFO'}");
  }
  $PATHINFO=lc($1);
}

if (!defined $PATHINFO) {die("PATH_INFO not defined");}

# The user is trying for the /db 'directory'... no such thing
if ($PATHINFO eq "" or $PATHINFO eq "/")
   {print $cgi->redirect("..");exit(0);}

# Put a slash on the end if you want browsers to work right
if ($PATHINFO !~ m,/$, && $PATHINFO !~ m/([.]png|[.]gif|blast)$/) 
   {
   my $qs=$ENV{'QUERY_STRING'};
   if (defined $qs and $qs ne "") {$qs="?$qs";} else {$qs="";}
   print $cgi->redirect("../db$PATHINFO/$qs");
   warn(Dumper(\%ENV));
   exit(0);
   }

# Remove the slash from the end for this program
$PATHINFO=~s/\/$//;

# Can't have the default header here:
if ($PATHINFO =~ m,^/study-(\d+)/experiment-(\d+)/spectra_peptide-(\d+).(png|gif)$,) 
   { showspectra_peptide_image($1,$2,$3,$4);exit(0);}

# Finally, send the header, no more redirections
print $cgi->header();
warningsToBrowser(1);

#############################################################################

# Common code for template toolkit/formbuilder
my $engine={
  INCLUDE_PATH => [ Template::Config->instdir('templates'), "." ],
  PRE_PROCESS => 'splash/config',
  EVAL_PERL => 1,
  #DEBUG => 'undef'
};
my $template = Template->new($engine);
my $vars=dbfuncs();
$vars->{base}="..$PATHINFO";
$vars->{base}=~s/[a-z0-9_+-]+/../g;


#############################################################################

# Studies:
if ($PATHINFO =~ m,^/study-(\d+)$,) 
   { showstudy($1);exit(0);}
if ($PATHINFO =~ m,^/study-(\d+)edit(ok)?$,) 
   { editstudy($1,$2);exit(0);}
if ($PATHINFO =~ m,^/study-(\d+)delete(ok)?$,) 
   { deletestudy($1,$2);exit(0);}

# Searches:
if ($PATHINFO =~ m,^/study-(\d+)/(present)-([a-z]+)$,) 
   { search($1,$2,$3);exit(0);}
if ($PATHINFO =~ m,^/study-(\d+)/(only)-([a-z\d_+]+)$,) 
   { search($1,$2,$3);exit(0);}

# Experiments:
if ($PATHINFO =~ m,^/study-(\d+)/experiment-(\d+)$,) 
   { showexperiment($1,$2);exit(0);}
if ($PATHINFO =~ m,^/study-(\d+)/experiment-(\d+)edit(ok)?$,) 
   { editexperiment($1,$2,$3);exit(0);}
if ($PATHINFO =~ m,^/study-(\d+)/experiment-(\d+)delete(ok)?$,) 
   { deleteexperiment($1,$2,$3);exit(0);}

# Spectra/peptides:
if ($PATHINFO =~ m,^/study-(\d+)/experiment-(\d+)/spectra_peptide-(\d+)$,) 
   { showspectra_peptide($1,$2,$3);exit(0);}
if ($PATHINFO =~ m,^/study-(\d+)/experiment-(\d+)/spectra_peptide-(\d+)edit(ok)?$,) 
   { editspectra_peptide($1,$2,$3,$4);exit(0);}
if ($PATHINFO =~ m,^/study-(\d+)/experiment-(\d+)/spectra_peptide-(\d+)delete(ok)?$,) 
   { deletespectra_peptide($1,$2,$3,$4);exit(0);}

# Protein Quantificatins:
if ($PATHINFO =~ m,^/study-(\d+)/experiment-(\d+)/protein_quantification-(\d+)$,) 
   { showprotein_quantification($1,$2,$3);exit(0);}
if ($PATHINFO =~ m,^/study-(\d+)/experiment-(\d+)/protein_quantification-(\d+)/spectra_peptide-(\d+)$,) 
   { showprotein_quantification($1,$2,$3,$4);exit(0);}
if ($PATHINFO =~ m,^/study-(\d+)/experiment-(\d+)/protein_quantification-(\d+)edit(ok)?$,) 
   { editprotein_quantification($1,$2,$3,$4);exit(0);}
if ($PATHINFO =~ m,^/study-(\d+)/experiment-(\d+)/protein_quantification-(\d+)delete(ok)?$,) 
   { deleteprotein_quantification($1,$2,$3,$4);exit(0);}

# Proteins:
if ($PATHINFO =~ m,^/study-(\d+)/experiment-(\d+)/protein-(\d+)$,) 
   { showprotein($1,$2,$3);exit(0);}
if ($PATHINFO =~ m,^/study-(\d+)/experiment-(\d+)/protein-(\d+)edit(ok)?$,) 
   { editprotein($1,$2,$3,$4);exit(0);}
if ($PATHINFO =~ m,^/study-(\d+)/experiment-(\d+)/protein-(\d+)delete(ok)?$,) 
   { deleteprotein($1,$2,$3,$4);exit(0);}

# Protein search page:
if ($PATHINFO =~ m,^/proteinsearch$,)
   { proteinsearch();exit(0);}

# Protein search page:
if ($PATHINFO =~ m,^/blast$,)
   { blast();exit(0);}

# Regulation search page
if ($PATHINFO =~ m,^/regulation$,)
   { regulation();exit(0);}

die("Unknown request: '$PATHINFO'");

#############################################################################

sub testit {
  my ($study)=@_;
  $vars->{study}=$_[0];
  $template->process("src/testit.ttml",$vars,undef)||die $template->error();
}

sub showstudy {
  my ($study)=@_;
  $vars->{study}=$_[0];
  $template->process("src/liststudy.ttml",$vars,undef)||die $template->error();
}

sub editstudy {
  my ($study,$confirm)=@_;
}

sub deletestudy {
  my ($study,$confirm)=@_;
}

# This was harder than I thought it would be:
sub search {
  my ($study,$type,$what)=@_;
  #print "search() got $study, $type, $what<br>\n";
  my $query;
  my $r;
  my $s;
  my $count;

  # Find those proteins that are "present" in an experiment (actually class)
  if ($type eq "present") {

    # Find the proteins, but list the *pq* ids:
    $query='select pq.id,p.accession_code,pq.experiment_id from
      protein_quantification as pq, experiment as e, protein as p where
      pq.experiment_id = e.id and pq.protein_id = p.id';
    # If not 'all' classes, then put on one more condition:
    if ($what ne "all") {$query.=" and e.class = '$what'";}
    $query.=' order by p.accession_code,pq.experiment_id';
    $r=getlist($query);

    # Count the proteins:
    $query='select distinct p.accession_code from
      protein_quantification as pq, experiment as e, protein as p where
      pq.experiment_id = e.id and pq.protein_id = p.id';
    # If not 'all' classes, then put on one more condition:
    if ($what ne "all") {$query.=" and e.class = '$what'";}
    $s=getlist($query);
    $count=(scalar(@$s));

  } else {

    # This searches for proteins that are "only" in some classes,
    # not in others, and don't care about the rest.
    # This is useful in a Venn diagram.

    # %search = hash of search values
    # (queen1+drone0+worker1) = {queen=>1, drone=>0, worker=>1}
    my %search=($what=~m/([a-z]+)(\d+)/g);

    # Constants to shorten the sql queries that come after:
    my $from="protein_quantification as pq, experiment as e, protein as p";
    my $where="pq.protein_id = p.id and pq.experiment_id = e.id";

    # Get a list of all proteins and protein quantifications ('the data').
    # But only from the classes we're interested in.
    # And sort by accession_code, then experiment class
    $query="select p.id, pq.id, p.accession_code, e.class from $from where $where";
    $query.=" and e.class in ('".join("', '",keys %search)."')";
    $query.=" order by p.accession_code, e.class";
    # We have to use arrays if we want to keep things sorted:
    $r=selectall_arrayref($query);
    my @alldata=@$r;
    # $alldata[X][0..3]=p.id, pq.id, p.accession_code, e.class

    # %all = set of all protein ids (unique) (with accession_code)
    my %all=map {$_->[0]=>$_->[2]} @alldata;
    # %lookup = go from pq ids to protein ids:
    my %lookup=map {$_->[1]=>$_->[0]} @alldata;
    # @final_order is the sorted order of the pq ids.
    my @final_order=map {$_->[1]} @alldata;

    # For each search key, get a list of proteins and cram into 'data'
    my %data;
    foreach my $m (keys %search) {
      $query="select p.id from $from where $where and e.class = '$m'";
      $r=getlist($query);
      $data{$m}={map {$_ =>1} @$r};
    }

    # For each protein, see if it's in all of the '1' keys and none of
    # the '0' keys.  (queen1+drone0+worker1)
    my $v;
    my %set;
    foreach (keys %all) {
      $v=1; # If this is zero, nobody gets in.
      # For each search key, 'AND' the value with whether the search
      # key equals the presence of the protein id.  1=defined, 0=not
      foreach my $m (keys %search) {
        $v=$v && ($search{$m} == defined ${$data{$m}}{$_} );
      }
      # If it passes the test, add this protein id to the list
      if ($v) {$set{$_}=1;}
    }

    # @set contains *protein* ids; the output needs to be *pq* ids:
    my @set2=grep {defined $set{$lookup{$_}}} @final_order;
    
    # Make it into a reference; template toolkit needs them.
    $r=\@set2;

    # The count of the *proteins*, not the *pq*s...
    $count=scalar(keys %set);
  }
  $vars->{study}=$study;
  $vars->{type}=$type;
  $vars->{what}=$what;
  $vars->{protein_quantificationlist}=(@$r>0)?$r:"";
  $vars->{count}=$count;
  $template->process("src/listproteinlist.ttml",$vars,undef)||die $template->error();
}

sub showexperiment {
  my ($study,$experiment)=@_;
  $vars->{study}=$_[0];
  $vars->{experiment}=$_[1];
  $template->process("src/listexperiment.ttml",$vars,undef)||die $template->error();
}

sub editexperiment {
  my ($study,$experiment,$confirm)=@_;
}

sub deleteexperiment {
  my ($study,$experiment,$confirm)=@_;
}

sub showspectra_peptide {
  my ($study,$experiment,$spectra_peptide)=@_;
  $vars->{study}=$_[0];
  $vars->{experiment}=$_[1];
  $vars->{spectra_peptide}=$_[2];
  $template->process("src/listspectra_peptide.ttml",$vars,undef)
    ||die $template->error();
}

# This parses and graphs the spectra field of the database, which is an
# ion in MGF format.  See http://www.matrixscience.com/help/data_file_help.html
sub showspectra_peptide_image {
  my ($study,$experiment,$spectra_peptide,$type)=@_;

  # Print a header for a gif or png file:
  print $cgi->header(-type=>"image/$type");

  # Get the spectra:
  my $r=getit("spectra_peptide","",$spectra_peptide);
  my $spectra=$r->{spectra};

  # If not in the database, return now.
  if (!defined $spectra or $spectra eq "") { return; }

  my @masses;
  my @intensities;
  my @annotations;
  my $max=0;
  # Read the spectra, looking for lines that have two real numbers:
  foreach (split(/\n/,$spectra)) {
    if (m/^([\d.]+) ([\d.]+)$/) {
      push @masses,$1;  # The masses
      push @intensities,$2;  # The intensities
      push @annotations,"";  # Blank annotations
      if ($2>$max) {$max=$2;}  # Find the maximum value while we're here
    }
  }
  # Annotate any peak that's more than 25% of the maximum:
  for (my $n=0;$n<@masses;$n++) {
    if ($intensities[$n]>0.25*$max) {$annotations[$n]=$masses[$n];}
  }
  # Graph it:
  print graphspectra(\@masses,\@intensities,\@annotations);
}

sub editspectra_peptide {
  my ($study,$experiment,$spectra_peptide,$confirm)=@_;
}

sub deletespectra_peptide {
  my ($study,$experiment,$spectra_peptide,$confirm)=@_;
}

sub showprotein_quantification {
  my ($study,$experiment,$protein_quantification)=@_;
  $vars->{study}=$_[0];
  $vars->{experiment}=$_[1];
  $vars->{protein_quantification}=$_[2];
  $vars->{spectra_peptide}=$_[3];
  $template->process("src/listprotein_quantification.ttml",$vars,undef)||die $template->error();
}

sub editprotein_quantification {
  my ($study,$experiment,$protein_quantification,$confirm)=@_;
}

sub deleteprotein_quantification {
  my ($study,$experiment,$protein_quantification,$confirm)=@_;
}

sub showprotein {
  my ($study,$protein)=@_;
  $vars->{study}=$_[0];
  $vars->{experiment}=$_[1];
  $vars->{protein}=$_[2];
  $template->process("src/listprotein.ttml",$vars,undef)||die $template->error();
}

sub editprotein {
  my ($study,$protein,$confirm)=@_;
}

sub deleteprotein {
  my ($study,$protein,$confirm)=@_;
}

sub proteinsearch {
  # Get the parameters, safely:
  my $accession_code="";
  if (!defined $cgi->param('accession_code') || $cgi->param('accession_code')
  !~ m/^\s*([a-zA-Z0-9._]*)\s*$/) {
    die("That was an invalid accession code.  Try a-z,0-9, period or underscore\n");
  }
  $accession_code=$1;

  my $description="";
  if (!defined $cgi->param('description') || $cgi->param('description')
  !~ m/^\s*([a-zA-Z0-9.\[\]:,\(\)\/ -]*)\s*$/) {
    die("That was an invalid protein description.  Try a-z,0-9, or some of these: -,:/.()[] \n");
  }
  $description=$1;

  # Build a nice query:
  my $query='select id,accession_code,description,sequence from protein';
  my $sep=" where";
  if ($description ne "") {
    $query.=$sep." description ilike '\%$description\%'";
    $sep=" and";
  }
  if ($accession_code ne "") {
    $query.=$sep." accession_code ilike '\%$accession_code\%'";
    $sep=" and";
  }
  $query.=' order by accession_code';
  # If neither description nor accession_code are present, this will print
  # everything.

  # Actually do the query:
  my $r=getlist($query);

  # Fill in the blanks:
  $sep="";
  if ($accession_code ne "") {
    $vars->{search}="${sep}accession_code contains '$accession_code'";
    $sep="and ";
  }
  if ($description ne "") {
    $vars->{search}.="${sep}description contains '$description'";
  }
  $vars->{proteinlist}=(@$r>0)?$r:"";
  $vars->{count}=@$r;

  # Render the form:
  $template->process("src/searchprotein.ttml",$vars,undef)||die $template->error();
}

sub blast {
  # Get the parameters:
  my $blastp=$cgi->param("blastp");
  if (!defined $blastp) {die("The search string was missing\n");}
  if ($blastp!~m/^([->a-zA-Z0-9_,:\/.()\[\]a-zA-Z0-9 \n\r]*)$/s) {
    $blastp=~s/[^->a-zA-Z0-9_,:\/.()\[\]a-zA-Z0-9 \n\r]+/[$&]/gs;
    die("The search string had bad characters in it: $blastp\n");
  }
  $blastp=$1;
  my @blines=split(/\n/,$blastp);
  foreach (@blines) {
    if (m/^>/) {next;}
    if (m/[jJoO]/) {
      die("The letters 'j' or 'o' were found in this sequence: $_\n");
    }
  }

  my $blasttable=$cgi->param("blasttable");
  if (!defined $blasttable) {die("The search matrix was undefined\n");}
  if ($blasttable!~m/^(blosum62|pam30)$/) {
    die("The search matrix choices are blosum62, or pam30.\n");
  }
  $blasttable=$1;
  my $matrix="-M $blasttable";
  
  # Find a unique filename to write this to:
  my $UNIQUE_ID=time().$$;
  if (defined $ENV{'UNIQUE_ID'} and $ENV{'UNIQUE_ID'}=~m/^([a-zA-Z0-9@-]{16,30})$/) {
    $UNIQUE_ID=$1;
  }

  # Actually process the results:
  mkdir("tmp");
  open(OUT,">tmp/$UNIQUE_ID") or die("tmp/$UNIQUE_ID: $!");
  print OUT $blastp,"\n";
  close(OUT);
  my $r=`/usr/bin/blastall -i tmp/$UNIQUE_ID -p blastp -d blast/apis_hemolymph.fa -TT $matrix 2>&1`;
  unlink("tmp/$UNIQUE_ID");

  # Fill in the blanks:
  $vars->{search}="Blast results";
  $vars->{input}=$blastp;
  $vars->{result}=$r;

  # Render the form:
  $template->process("src/blastout.ttml",$vars,undef)||die $template->error();
}

sub regulation {
  # Get the parameters:
  my $left=$cgi->param("left");
  if (!defined $left) {die("The left parameter was missing\n");}
  if ($left!~m/^([a-z]{1,20})$/) {
    die("The left parameter had bad characters in it: $left\n");
  }
  $left=$1;

  my $middle=$cgi->param("middle");
  if (!defined $middle) {die("The middle parameter was missing\n");}
  if ($middle!~m/^(lessthan|morethan)$/) {
    die("The middle parameter wasn't 'lessthan' or 'morethan'.\n");
  }
  $middle=$1;

  my $right=$cgi->param("right");
  if (!defined $right) {die("The right parameter was missing\n");}
  if ($right!~m/^([a-z]{1,20})$/) {
    die("The right parameter had bad characters in it: $right\n");
  }
  $right=$1;

  if ($left eq $right) {
    die("The left parameter is the same as the right parameter $left == $right!");
  }

# Insert queries here.
  my $from="protein_quantification as pq, experiment as e, protein as p";
  my $where="pq.protein_id = p.id and pq.experiment_id = e.id";
  my $query="select p.accession_code, e.class, pq.average_quantity from $from where $where and e.class in ('$left','$right')";
  my $r=selectall_arrayref($query);
  my @alldata=@$r;
  my %left;
  my %right;
  my %protlist;
  foreach my $m (@alldata) {
    if ($m->[1] eq $left) { $left{$m->[0]}=$m->[2]; }
    if ($m->[1] eq $right) { $right{$m->[0]}=$m->[2]; }
    $protlist{$m->[0]}.=$m->[1]." ";
  }

  my @result;
  my $n;
  my $lv; # left value
  my $rv; # right value
  foreach my $m (sort keys %protlist) {
    $rv=$lv=0;
    if (defined $left{$m}) {$lv=$left{$m};} # undefined=0
    if (defined $right{$m}) {$rv=$right{$m};} # undefined=0
    if ($middle eq "lessthan" and $lv < $rv) { push @result,"<tr><td>$m</td><td></td><td>$lv</td><td>&lt;</td><td>$rv</td></tr>"; }
    if ($middle eq "morethan" and $lv > $rv) { push @result,"<tr><td>$m</td><td></td><td>$lv</td><td>&gt;</td><td>$rv</td></tr>"; }
  }
  #print $cgi->pre(Dumper(\@result));

  # Fill in the blanks:
  $vars->{search}="Protein regulation results";
  my $verb="has";
  if ($left =~m/s$/) {$verb="have";}
  $vars->{input}=" $left $verb ".(($middle eq "morethan")?"more":"less")." protein than $right.";
  $vars->{left}=ucfirst($left);
  $vars->{right}=ucfirst($right);
  $vars->{resultlist}=\@result;
  $vars->{count}=scalar(@result);

  # Render the form:
  $template->process("src/regulation.ttml",$vars,undef)||die $template->error();
}
